home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic 4 Database How-To
/
Visual Basic 4 Database - How-to (The Waite Group)(1995).iso
/
maillist.fr_
/
maillist.fr
Wrap
Text File
|
1995-04-04
|
9KB
|
276 lines
VERSION 4.00
Begin VB.Form frmMailList
Caption = "Print Sorted Mailing List"
ClientHeight = 3495
ClientLeft = 1095
ClientTop = 1500
ClientWidth = 5610
Height = 3900
Left = 1035
LinkTopic = "Form1"
ScaleHeight = 3495
ScaleWidth = 5610
Top = 1155
Width = 5730
Begin VB.CommandButton cmdQuit
Caption = "&Quit"
Height = 495
Left = 4080
TabIndex = 10
Top = 2160
Width = 1215
End
Begin VB.CommandButton cmdReport
Caption = "&Print Report"
Default = -1 'True
Height = 495
Left = 2400
TabIndex = 9
Top = 2160
Width = 1215
End
Begin VB.TextBox txtValue
Height = 285
Left = 360
TabIndex = 8
Top = 1200
Visible = 0 'False
Width = 2055
End
Begin VB.Frame Frame1
Caption = "Select Page Number Format"
Height = 1575
Left = 3000
TabIndex = 4
Top = 240
Width = 2295
Begin VB.OptionButton optPageNoType
Caption = "page &one"
Height = 255
Index = 2
Left = 360
TabIndex = 7
Top = 1080
Width = 1215
End
Begin VB.OptionButton optPageNoType
Caption = "&1"
Height = 255
Index = 1
Left = 360
TabIndex = 6
Top = 720
Width = 1215
End
Begin VB.OptionButton optPageNoType
Caption = "&Page 1"
Height = 255
Index = 0
Left = 360
TabIndex = 5
Top = 360
Value = -1 'True
Width = 1215
End
End
Begin VB.PictureBox Picture1
Align = 2 'Align Bottom
BackColor = &H00C0C0C0&
Height = 495
Left = 0
ScaleHeight = 465
ScaleWidth = 5580
TabIndex = 1
Top = 3000
Width = 5610
Begin VB.Label lblStatus
BackColor = &H00C0C0C0&
Height = 255
Left = 120
TabIndex = 2
Top = 120
Width = 6495
End
End
Begin VB.ComboBox lstReportType
Height = 300
ItemData = "MAILLIST.frx":0000
Left = 360
List = "MAILLIST.frx":0007
Style = 2 'Dropdown List
TabIndex = 0
Top = 480
Width = 2055
End
Begin VB.Label Label1
Caption = "&Select Report Type:"
Height = 195
Left = 360
TabIndex = 11
Top = 240
Width = 2055
End
Begin VB.Label lblInstruction
AutoSize = -1 'True
Height = 195
Left = 360
TabIndex = 3
Top = 960
Visible = 0 'False
Width = 45
End
Begin Crystal.CrystalReport CrystalReport1
Left = 0
Top = 1800
_extentx = 741
_extenty = 741
_stockprops = 0
reportfilename = "d:\winword\writing\database\crystal\maillist.rpt"
destination = 0
windowleft = 100
windowtop = 100
windowwidth = 490
windowheight = 300
windowtitle = ""
windowborderstyle= 2
windowcontrolbox= -1 'True
windowmaxbutton = -1 'True
windowminbutton = -1 'True
copiestoprinter = 1
printfilename = ""
printfiletype = 0
selectionformula= ""
groupselectionformula= ""
connect = ""
username = ""
End
End
Attribute VB_Name = "frmMailList"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdQuit_Click()
End
End Sub
Private Sub cmdReport_Click()
Dim ZipDigits As String
lblStatus.Caption = "Setting report options. Please wait..."
DoEvents
Select Case lstReportType.Text
Case "City"
'Set the filter and title for the report
If Len(txtValue) Then
CrystalReport1.SelectionFormula = "{Mailing LIst.CITY}= '" & txtValue & "'"
CrystalReport1.Formulas(0) = "ReportTitle= 'Mailing List for City of " & txtValue & "'"
Else
CrystalReport1.SelectionFormula = ""
CrystalReport1.Formulas(0) = "ReportTitle= 'Full City Mailing List'"
End If
'Set the sort order and clear second element
CrystalReport1.SortFields(0) = "+{Mailing LIst.CITY}"
CrystalReport1.SortFields(1) = "+{Mailing LIst.ZIP}"
CrystalReport1.SortFields(2) = ""
Case "State"
'Set the filter and title for the report
If Len(txtValue) Then
CrystalReport1.SelectionFormula = "{Mailing LIst.STATE}= '" & txtValue & "'"
CrystalReport1.Formulas(0) = "ReportTitle= 'Mailing List for State of " & txtValue & "'"
Else
CrystalReport1.SelectionFormula = "{Mailing LIst.STATE}= {Mailing LIst.STATE}"
CrystalReport1.Formulas(0) = "ReportTitle= 'Full State Mailing List'"
End If
'Set the sort order
CrystalReport1.SortFields(0) = "+{Mailing LIst.STATE}"
CrystalReport1.SortFields(1) = "+{Mailing LIst.CITY}"
CrystalReport1.SortFields(2) = "+{Mailing LIst.ZIP}"
Case "Zip"
'Set the filter and title for the report
If Len(txtValue) Then
ZipDigits = Trim(Str(Len(txtValue)))
CrystalReport1.SelectionFormula = "{Mailing LIst.ZIP}[1 to " & ZipDigits & "]= '" & txtValue & "'"
CrystalReport1.Formulas(0) = "ReportTitle= 'Mailing List for Zip Code " & txtValue & "'"
Else
CrystalReport1.SelectionFormula = "{Mailing LIst.ZIP}= {Mailing LIst.ZIP}"
CrystalReport1.Formulas(0) = "ReportTitle= 'Full Zip Code Mailing List'"
End If
'Set the sort order
CrystalReport1.SortFields(0) = "+{Mailing LIst.ZIP}"
CrystalReport1.SortFields(1) = ""
CrystalReport1.SortFields(2) = ""
End Select
'Print the report
lblStatus.Caption = "Printing the report. Please wait..."
DoEvents
CrystalReport1.Action = 1
lblStatus.Caption = "Enter new selections and print or quit."
DoEvents
End Sub
Private Sub Form_Load()
'Load the lstReportType list box
lstReportType.Clear
lstReportType.AddItem "City"
lstReportType.AddItem "State"
lstReportType.AddItem "Zip"
lblStatus.Caption = "Select a report type."
'Set the initial value of the page format
optPageNoType_Click (0)
End Sub
Private Sub lstReportType_Click()
If Len(lstReportType.Text) Then
Select Case lstReportType.Text
Case "City"
lblInstruction.Caption = "&Enter the City name:"
lblStatus.Caption = "Enter a city name or blank for all."
Case "State"
lblInstruction.Caption = "&Enter the State name:"
lblStatus.Caption = "Enter a state name or blank for all."
Case "Zip"
lblInstruction.Caption = "&Enter the Zip Code:"
lblStatus.Caption = "Enter a zip code or blank for all."
End Select
txtValue.Text = ""
lblInstruction.Visible = True
txtValue.Visible = True
txtValue.SetFocus
Else
lblInstruction.Visible = False
txtValue.Text = ""
txtValue.Visible = False
End If
End Sub
Private Sub optPageNoType_Click(Index As Integer)
'Set the page number format
Select Case Index
Case 0
CrystalReport1.Formulas(1) = "PageFooter= 'Page ' + ToText(PageNumber, 0)"
Case 1
CrystalReport1.Formulas(1) = "PageFooter= ToText(PageNumber, 0)"
Case 2
CrystalReport1.Formulas(1) = "PageFooter= 'page ' + ToWords(PageNumber, 0)"
End Select
End Sub